home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - Pascal / PAS027.dsk / MICROMODEM.TEXT.txt < prev    next >
Text File  |  2012-02-16  |  7KB  |  333 lines
  1. (*$S+*)
  2. UNIT MICROMODEM;
  3.  
  4. INTERFACE
  5.  
  6. CONST SECONDS=100;
  7.  
  8. TYPE MODEMSLOT=1..3;
  9.      BAUDRATE=(RATE110,RATE300);
  10.      PARITYKIND=(EVENPARITY,ODDPARITY,NOPARITY);
  11.      MODETYPE=(ANSWER,ORIGINATE);
  12.      L7OR8=7..8;
  13.      S1OR2=1..2;
  14.  
  15.      UMODEMCONTROL=PACKED RECORD
  16.                  ACIACLK: 0..3;
  17.                  WORDSEL: 0..7;
  18.                  XMITCTL: 0..3;
  19.                  RIE: BOOLEAN;
  20.                  BRS: BAUDRATE;
  21.                  TXE: BOOLEAN;
  22.                  MODE: MODETYPE;
  23.                  NOTRESET: BOOLEAN;
  24.                  SELFTEST: BOOLEAN;
  25.                  UNUSEDBITS: 0..3;
  26.                  OFFHOOK: BOOLEAN;
  27.                  END;
  28.  
  29.      UMODEMSTATUS=PACKED RECORD
  30.                     RDRF: BOOLEAN;
  31.                     TDRE: BOOLEAN;
  32.                     NOTDCD: BOOLEAN;
  33.                     NOTCTS: BOOLEAN;
  34.                     FE: BOOLEAN;
  35.                     OVRN: BOOLEAN;
  36.                     PE: BOOLEAN;
  37.                     IRQ: BOOLEAN;
  38.                     UNUSEDBITS: 0..127;
  39.                     NOTRI: BOOLEAN;
  40.                     END;
  41.  
  42. VAR MODEMCONTROL: UMODEMCONTROL;
  43.  
  44. (* PHONE LINE CONTROL *)
  45. PROCEDURE PICKUP;
  46. PROCEDURE HANGUP;
  47. FUNCTION RINGING: BOOLEAN;
  48. PROCEDURE DIAL(NUMBER:STRING);
  49.  
  50. (* MODEM CONTROL *)
  51. PROCEDURE SETMODE(NEWMODE:MODETYPE);
  52. PROCEDURE TXON;
  53. PROCEDURE TXOFF;
  54. FUNCTION CARRIER: BOOLEAN;
  55.  
  56. (* ACIA CONTROL *)
  57. PROCEDURE SENDBREAK(TIME:INTEGER);
  58. PROCEDURE SETRATE(NEWRATE:BAUDRATE);
  59. FUNCTION MODEMINPUT: BOOLEAN;
  60. FUNCTION MODEMREADY: BOOLEAN;
  61. PROCEDURE CHARFORMAT(CHARLEN:L7OR8; STOPBITS:S1OR2; PARITY:PARITYKIND);
  62.  
  63. (* FUNDAMENTAL ROUTINES *)
  64. PROCEDURE USEMODEM(SLOT:MODEMSLOT);
  65. PROCEDURE DCHCONTROL(CTL:UMODEMCONTROL);
  66. PROCEDURE DCHSTATUS(VAR STATUS:UMODEMSTATUS);
  67. PROCEDURE DELAY10MS(TIME:INTEGER);
  68.  
  69. (* STRING INPUT ROUTINE *)
  70. PROCEDURE READMODEM(VAR MODEMIN,MODEMOUT:INTERACTIVE; VAR S:STRING;
  71.   VAR CH:CHAR);
  72.  
  73.  
  74. IMPLEMENTATION
  75.  
  76. CONST IOPAGE=192;       (* =$C0 *)
  77.  
  78. TYPE CHARPTR=^ CHAR;
  79. VAR FINDMODEM: MODEMSLOT;
  80.     FOUND,MISSING: BOOLEAN;
  81.     FOOL: RECORD
  82.            CASE BOOLEAN OF
  83.              TRUE: (ADDR: PACKED RECORD
  84.                             LO: 0..255;
  85.                             HI: 0..255;
  86.                             END);
  87.              FALSE: (P: ^ CHAR);
  88.              END;
  89.     MODEMCS: CHARPTR;
  90.     ACIADATA: CHARPTR;
  91.  
  92. PROCEDURE DCHCTL(MODEMADDR:CHARPTR; CTL:UMODEMCONTROL);
  93.   EXTERNAL;
  94.  
  95. PROCEDURE DCHSTS(MODEMADDR:CHARPTR; VAR STATUS:UMODEMSTATUS);
  96.   EXTERNAL;
  97.  
  98. FUNCTION ISDCHAYES(SLOT:MODEMSLOT): BOOLEAN;
  99.   EXTERNAL;
  100.  
  101. PROCEDURE DCHCONTROL;
  102. BEGIN
  103.   DCHCTL(MODEMCS,CTL);
  104.   END;
  105.  
  106. PROCEDURE DCHSTATUS;
  107. BEGIN
  108.   DCHSTS(MODEMCS,STATUS);
  109.   END;
  110.  
  111. PROCEDURE DELAY10MS;
  112. CONST CNT10MS=15;
  113. VAR I,J: INTEGER;
  114. BEGIN
  115.   FOR I:=TIME DOWNTO 0 DO
  116.    FOR J:=1 TO CNT10MS DO;
  117.   END;
  118.  
  119. PROCEDURE PICKUP;
  120. BEGIN
  121.   DELAY10MS(1*SECONDS);
  122.   MODEMCONTROL.OFFHOOK:=TRUE;
  123.   DCHCONTROL(MODEMCONTROL);
  124.   DELAY10MS(2*SECONDS);
  125.   END;
  126.  
  127. PROCEDURE HANGUP;
  128. BEGIN
  129.   MODEMCONTROL.OFFHOOK:=FALSE;
  130.   DCHCONTROL(MODEMCONTROL);
  131.   END;
  132.  
  133. FUNCTION RINGING;
  134. VAR STATUS: UMODEMSTATUS;
  135. BEGIN
  136.   DCHSTATUS(STATUS);
  137.   RINGING:=NOT STATUS.NOTRI;
  138.   END;
  139.  
  140. PROCEDURE DIAL;
  141. VAR STRPTR,DIGIT: INTEGER;
  142.  PROCEDURE DIALDIGIT(COUNT:INTEGER);
  143.  VAR I: INTEGER;
  144.  BEGIN
  145.    FOR I:=1 TO COUNT DO BEGIN
  146.      MODEMCONTROL.OFFHOOK:=FALSE;
  147.      DCHCONTROL(MODEMCONTROL);
  148.      DELAY10MS(5);
  149.      MODEMCONTROL.OFFHOOK:=TRUE;
  150.      DCHCONTROL(MODEMCONTROL);
  151.      DELAY10MS(3);
  152.      END;
  153.    DELAY10MS(70);
  154.    END;
  155. BEGIN
  156.   FOR STRPTR:=1 TO LENGTH(NUMBER) DO BEGIN
  157.     DIGIT:=POS(COPY(NUMBER,STRPTR,1),'1234567890*#');
  158.     IF DIGIT<>0 THEN DIALDIGIT(DIGIT)
  159.     ELSE IF NUMBER[STRPTR]='.' THEN DELAY10MS(1*SECONDS)
  160.     ELSE IF NUMBER[STRPTR]='/' THEN BEGIN
  161.       MODEMCONTROL.OFFHOOK:=FALSE;
  162.       DCHCONTROL(MODEMCONTROL);
  163.       DELAY10MS(50);
  164.       MODEMCONTROL.OFFHOOK:=TRUE;
  165.       DCHCONTROL(MODEMCONTROL);
  166.       DELAY10MS(2*SECONDS);
  167.       END;
  168.     END;
  169.   END;
  170.  
  171. PROCEDURE SETMODE;
  172. BEGIN
  173.   MODEMCONTROL.MODE:=NEWMODE;
  174.   DCHCONTROL(MODEMCONTROL);
  175.   END;
  176.  
  177. PROCEDURE TXON;
  178. BEGIN
  179.   MODEMCONTROL.TXE:=TRUE;
  180.   DCHCONTROL(MODEMCONTROL);
  181.   END;
  182.  
  183. PROCEDURE TXOFF;
  184. BEGIN
  185.   MODEMCONTROL.TXE:=FALSE;
  186.   DCHCONTROL(MODEMCONTROL);
  187.   END;
  188.  
  189. FUNCTION CARRIER;
  190. VAR STATUS: UMODEMSTATUS;
  191.     CH: CHAR;
  192. BEGIN
  193.   DCHSTATUS(STATUS);
  194.   IF STATUS.NOTDCD THEN BEGIN
  195.     CH:=ACIADATA^;
  196.     DCHSTATUS(STATUS);
  197.     END;
  198.   CARRIER:=NOT STATUS.NOTDCD;
  199.   END;
  200.  
  201. PROCEDURE SENDBREAK;
  202. BEGIN
  203.   MODEMCONTROL.XMITCTL:=3;
  204.   DCHCONTROL(MODEMCONTROL);
  205.   DELAY10MS(TIME);
  206.   MODEMCONTROL.XMITCTL:=0;
  207.   DCHCONTROL(MODEMCONTROL);
  208.   END;
  209.  
  210. PROCEDURE SETRATE;
  211. BEGIN
  212.   MODEMCONTROL.BRS:=NEWRATE;
  213.   DCHCONTROL(MODEMCONTROL);
  214.   END;
  215.  
  216. PROCEDURE CHARFORMAT;
  217. BEGIN
  218.   IF CHARLEN=7 THEN
  219.    IF PARITY<>NOPARITY THEN
  220.     MODEMCONTROL.WORDSEL:=2*(1-STOPBITS DIV 2)+ORD(PARITY)
  221.    ELSE (* NOPARITY IS ILLEGAL *)
  222.   ELSE (* CHARLEN=8 *)
  223.    IF PARITY=NOPARITY THEN
  224.     MODEMCONTROL.WORDSEL:=4+(1-STOPBITS DIV 2)
  225.    ELSE IF STOPBITS=1 THEN
  226.     MODEMCONTROL.WORDSEL:=6+ORD(PARITY)
  227.    ELSE (* STOPBITS=2 IS ILLEGAL *);
  228.   DCHCONTROL(MODEMCONTROL);
  229.   END;
  230.  
  231. FUNCTION MODEMINPUT;
  232. VAR STATUS: UMODEMSTATUS;
  233. BEGIN
  234.   DCHSTATUS(STATUS);
  235.   MODEMINPUT:=STATUS.RDRF;
  236.   END;
  237.  
  238. FUNCTION MODEMREADY;
  239. VAR STATUS: UMODEMSTATUS;
  240. BEGIN
  241.   DCHSTATUS(STATUS);
  242.   MODEMREADY:=STATUS.TDRE;
  243.   END;
  244.  
  245. PROCEDURE READMODEM;
  246. CONST CR=13; BS=8; DEL=127; CAN=24; BEL=7;
  247. VAR CURPOS,I: INTEGER;
  248.  PROCEDURE RUBOUT;
  249.  BEGIN
  250.    WRITE(MODEMOUT,CHR(BS),' ',CHR(BS));
  251.    END;
  252. BEGIN
  253.   S:='';
  254.   CURPOS:=1;
  255.   REPEAT
  256.     WHILE CARRIER AND NOT MODEMINPUT DO;
  257.     IF CARRIER THEN BEGIN
  258.       READ(MODEMIN,CH);
  259.       IF EOLN(MODEMIN) THEN CH:=CHR(CR);
  260.       IF ORD(CH)>=128 THEN CH:=CHR(ORD(CH)-128);
  261.       IF (CH=CHR(BS)) OR (CH=CHR(DEL)) THEN BEGIN
  262.         IF CURPOS<=1 THEN WRITE(MODEMOUT,CHR(BEL))
  263.         ELSE BEGIN
  264.           RUBOUT;
  265.           CURPOS:=CURPOS-1;
  266.           END;
  267.         CH:=CHR(BS);
  268.         END
  269.       ELSE IF CH=CHR(CAN) THEN BEGIN
  270.         IF CURPOS<=1 THEN WRITE(MODEMOUT,CHR(BEL))
  271.         ELSE BEGIN
  272.           FOR I:=CURPOS DOWNTO 1 DO RUBOUT;
  273.           CURPOS:=1;
  274.           END;
  275.         CH:=CHR(BS);
  276.         END
  277.       ELSE IF CH=CHR(CR) THEN WRITELN(MODEMOUT)
  278.       ELSE IF CH>=' ' THEN WRITE(MODEMOUT,CH);
  279.       END
  280.     ELSE CH:=CHR(DEL);
  281.     IF CH>=' ' THEN BEGIN
  282.       INSERT(' ',S,CURPOS);
  283.       S[CURPOS]:=CH;
  284.       CURPOS:=CURPOS+1;
  285.       END;
  286.     UNTIL (CH<' ') AND (CH<>CHR(BS)) OR (CH=CHR(DEL));
  287.   END;
  288.  
  289. PROCEDURE USEMODEM;
  290. VAR TEMP: INTEGER;
  291. BEGIN
  292.   TEMP:=SLOT*16+128;
  293.   FOOL.ADDR.HI:=IOPAGE;
  294.   FOOL.ADDR.LO:=TEMP+5;
  295.   MODEMCS:=FOOL.P;
  296.   FOOL.ADDR.LO:=TEMP+7;
  297.   ACIADATA:=FOOL.P;
  298.   END;
  299.  
  300. BEGIN
  301.   FINDMODEM:=3;
  302.   FOUND:=FALSE;
  303.   MISSING:=FALSE;
  304.   WHILE NOT FOUND AND NOT MISSING DO BEGIN
  305.     FOUND:=ISDCHAYES(FINDMODEM);
  306.     MISSING:=NOT FOUND AND (FINDMODEM=1);
  307.     IF NOT MISSING AND NOT FOUND THEN FINDMODEM:=FINDMODEM-1;
  308.     END;
  309.   IF FOUND THEN USEMODEM(FINDMODEM)
  310.   ELSE BEGIN
  311.     WRITELN('NO MICROMODEM II');
  312.     EXIT(PROGRAM);
  313.     END;
  314.   WITH MODEMCONTROL DO BEGIN
  315.     ACIACLK:=3;
  316.     WORDSEL:=4;
  317.     XMITCTL:=0;
  318.     RIE:=FALSE;
  319.     BRS:=RATE300;
  320.     TXE:=FALSE;
  321.     MODE:=ANSWER;
  322.     NOTRESET:=FALSE;
  323.     SELFTEST:=FALSE;
  324.     UNUSEDBITS:=0;
  325.     OFFHOOK:=FALSE;
  326.     END;
  327.   DCHCONTROL(MODEMCONTROL);
  328.   MODEMCONTROL.ACIACLK:=1;
  329.   MODEMCONTROL.NOTRESET:=TRUE;
  330.   DCHCONTROL(MODEMCONTROL);
  331.   END.
  332.  
  333.